perm filename DUMPEM.SAI[1,KMC] blob sn#006428 filedate 1972-08-16 generic text, type T, neo UTF8
00100	BEGIN "DUMPEM"
00200		INTEGER ARRAY HSTBUF[0:127];
00300		INTEGER ARRAY DRCTRY[0:127];
00400		INTEGER GAME,HR,MIN,SEC,LASTGAME,DENT,HENT,D,H,FLAG;
00500		INTEGER DATE,OLDDATE,NORMAL,TIME,CHAR,IGNORE,NOCHARS;
00550		INTEGER DATEMASK,TIMEMASK,DAY,MO,YR;
00600		STRING FILNAM,EFFECTIVE;
00700		LABEL GETNAM;
00800		DEFINE CRLF="13&10";
00900		DEFINE HSTCHN="11";
01000		DEFINE RPTCHN="10";
01100		DEFINE FORMDATE="
01200		START_CODE
01300		MOVE  '15,DENT;
01400		AND  '15,DATEMASK;
01500		MOVEM  '15,DATE;
01600		END";
01700		DEFINE FORMNORM="
01800		QUICK_CODE
01900		MOVE  '15,DENT;
02000		LSH  '15,-35;
02100		MOVEM  '15,NORMAL;
02200		END";
02300		DEFINE SPLITENT="
02400		START_CODE
02500		MOVE  '15,HENT;
02600		MOVE  '14,'15;
02700		AND  '14,TIMEMASK;
02800		MOVEM  '14,TIME;
02900		MOVE  '14,'15;
03000		LSH  '14,-24;
03050		MOVE  '13,'14;
03100		ANDI  '14,'17;
03200		MOVEM  '14,GAME;
03210		LSH  '13,-4;
03215		ANDI  '13,1;
03220		MOVEM  '13,IGNORE;
03300		LSH  '15,-29;
03350		SUBI  '15,'40;
03400		MOVEM  '15,CHAR;
03500		END";
03550		DATE←OLDDATE←0;
03555		NORMAL←1;
03560		DATEMASK←'007777777777;
03570		TIMEMASK←'000077777777;
03600	GETNAM:	OUTSTR(CRLF & "TYPE THE CHILD'S NAME, THEN CARRIAGE RETURN: ");
03800		FILNAM←INCHWL;
03900		OPEN(HSTCHN,"DSK",15,0,0,0,0,0);
04000		LOOKUP(HSTCHN,FILNAM&".HST[1,KMC]",FLAG);
04100		IF FLAG THEN BEGIN
04200			OUTSTR("FILE "&FILNAM&".HST [1,KMC] NOT FOUND");
04300			RELEASE(HSTCHN);
04400			GOTO GETNAM;
04500			END;
04600		OPEN(RPTCHN,"DSK",0,0,2,0,0,0);
04700		ENTER(RPTCHN,FILNAM&".RPT",FLAG);
04800		ARRYIN(HSTCHN,DRCTRY[0],128);
04900		D←1;
05000		WHILE DRCTRY[D]≠0 LAND D<128 OR DRCTRY[D+1]≠0 LAND D<128  DO BEGIN
05100			DENT←DRCTRY[D];
05200			D←D+1;
05300			FORMDATE;
05400			IF DATE≠OLDDATE THEN BEGIN
05450				IF OLDDATE≠0 THEN BEGIN
05500					OUT(RPTCHN,"END OF SESSION"&CRLF&CRLF&CRLF);
05550					IF NORMAL THEN OUT(RPTCHN,
05560						"SESSION ENDED NORMALLY"&CRLF)
05565					 ELSE OUT(RPTCHN,
05567						"SYSTEM CRASHED"&CRLF);
05570					END;
05575				DAY←(DATE MOD 31)+1;
05580				MO←((DATE DIV 31)MOD 12)+1;
05585				YR←((DATE DIV 31)DIV 12)+64;
05600				OUT(RPTCHN,"SESSION OF "&CVS(MO)&"/"&CVS(DAY)&"/"
05605				 &CVS(YR)&CRLF&CRLF);
05700				END;
05900			FORMNORM;
05950			IF DATE=OLDDATE AND ¬NORMAL THEN
05975			 OUT(RPTCHN,CRLF&"SYSTEM CRASHED"&CRLF);
06000			OLDDATE←DATE;
06100			ARRYIN(HSTCHN,HSTBUF[0],128);
06200			NOCHARS←HSTBUF[0] MOD '1000000;
06300			FOR H←1 STEP 1 UNTIL NOCHARS DO BEGIN
06400				HENT←HSTBUF[H];
06600				SPLITENT;
06700				TIME←TIME DIV 60;
06800				SEC←TIME MOD 60;
06900				MIN←(TIME DIV 60)MOD 60;
07000				HR←TIME DIV 3600;
07010				IF ¬IGNORE THEN EFFECTIVE←"EFFECTIVE"
07020				 ELSE EFFECTIVE←" ";
07100				IF GAME ≠ LASTGAME THEN OUT(RPTCHN,CRLF);
07200				OUT(RPTCHN,CVS(GAME)&"   "&CVXSTR(CHAR)&"   "&CVS(HR)
07300				 &":"&CVS(MIN)&":"&CVS(SEC)&" "&EFFECTIVE&CRLF);
07400				LASTGAME←GAME;
07500				END;
07600			END;
07650		IF ¬NORMAL THEN OUT(RPTCHN,CRLF&"SYSTEM CRASHED"&CRLF);
07700		OUT(RPTCHN,"END OF LAST SESSION");
07800		RELEASE(RPTCHN);
07900		RELEASE(HSTCHN);
07950		OUTSTR("REPORT IS ON "&FILNAM&".RPT"&CRLF);
08000		END "DUMPEM";